;;;    $Id, lt-preferences.scm $
;;;
;;;    lambda-tube (λ-tube) - A youtube search API and application in scheme.
;;;    Copyright (C) 2008  Abhishek Mishra
;;;
;;;    This program is free software: you can redistribute it and/or modify
;;;    it under the terms of the GNU General Public License as published by
;;;    the Free Software Foundation, either version 3 of the License, or
;;;    (at your option) any later version.

;;;    This program is distributed in the hope that it will be useful,
;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;    GNU General Public License for more details.

;;;    You should have received a copy of the GNU General Public License
;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.

;A preferences dialog and load-pref method
(module lt-pref-dialog mzscheme
  (require (lib "class.ss")
           (lib "mred.ss" "mred")
           (lib "file.ss")
           (lib "url.ss" "net")
           "lt-app-details.scm"
           "lt-i18n.scm"
           "lt-preferences.scm"
           "lt-search-history.scm")
  
  (provide prefs
           tncache-folder 
           video-folder
           resultspp
           show-images?
           show-comments?
           save-history?
           history-size
           load-prefs
           get-preferences-dialog
           use-proxy?
           proxy-details
           play-video-on-download?)
  
  ;define preferences
  (define prefs (new lt-prefs%))
  (define tncache-folder "")
  (define video-folder "")
  (define resultspp "")
  (define show-images? "")
  (define show-comments? "")
  (define save-history? "")
  (define play-video-on-download? "")
  (define history-size "")
  (define proxy-details '())
  
  (if (initial-setup-required?)
      (initial-setup))
  
  ;tests whether http proxy is set
  (define (use-proxy?)
    (is-proxy-enabled? proxy-details))
  
  ;sets the current proxy server
  (define (set-current-proxy-server)
    (set! proxy-details (send prefs get-param http-proxy-details-param))
    (if (use-proxy?)
        (current-proxy-servers (list (list "http" 
                                           (get-host-for-proxy proxy-details)
                                           (string->number (get-port-for-proxy proxy-details)))))
        (current-proxy-servers (list))))
  
  ;define load prefs function  
  (define (load-prefs)
    (init-i18n)
    (send prefs load-values)
    (set! tncache-folder (send prefs get-param thumbnail-cache-folder-param))
    (set! video-folder (send prefs get-param video-cache-folder-param))
    (set! resultspp (send prefs get-param results-per-page-param))
    (set! show-images? (send prefs get-param show-images?-param))
    (set! show-comments? (send prefs get-param show-comments?-param))
    (set! save-history? (send prefs get-param save-history?-param))
    (set! play-video-on-download? (send prefs get-param play-video-on-download?-param))
    (set! history-size (send prefs get-param history-size-param))
    (set-current-proxy-server)
    (set-language (get-language-by-name (send prefs get-param language-param)))
    (make-directory* tncache-folder)
    (make-directory* video-folder)
    (load-search-history)
    (if (not save-history?) (clear-history)) 
    (set-history-size (string->number history-size))
    )
  
  (load-prefs)
  
  (define (get-preferences-dialog parent-frame)
    (let* ((pref-label (format (get-string "PREFERENCES_TITLE_LABEL") (get-string app-name) (get-string app-version)))
           (prefd (new dialog% 
                       [parent parent-frame] 
                       [label pref-label]
                       [min-width 200] 
                       [min-height 100]))
           (prefs (new lt-prefs%)))
      (send prefs load-values-from-file (path->string (get-prefs-file-name)))
      (let* ((pref-vpanel (new vertical-panel% [parent prefd] [alignment '(left top)]))
             (title-hpanel (new horizontal-panel% [parent pref-vpanel] [alignment '(center top)]))
             (title-msg (new message% 
                             [label pref-label] 
                             [parent title-hpanel]
                             [font (make-object font% 12 'default)]))
             
             ;proxy details
             (proxy-hpanel (new horizontal-panel% [parent prefd] [alignment '(left top)]))
             (proxy-host-field (new text-field% 
                                    [label (get-string "PROXY_HOST_PREFERENCE_LABEL")] 
                                    [parent proxy-hpanel] 
                                    [enabled (use-proxy?)]
                                    [init-value (get-host-for-proxy proxy-details)]))
             (proxy-port-field (new text-field% 
                                    [label (get-string "PROXY_PORT_PREFERENCE_LABEL")] 
                                    [parent proxy-hpanel]
                                    [enabled (use-proxy?)]
                                    [init-value (get-port-for-proxy proxy-details)]))
             (use-proxy-field (new check-box% 
                                   [label (get-string "USE_PROXY_PREFERENCE_LABEL")] 
                                   [parent proxy-hpanel] 
                                   [value (use-proxy?)]
                                   (callback (lambda (check-box event)
                                               (let ((cbval (send check-box get-value)))
                                                 (send proxy-host-field enable cbval)
                                                 (send proxy-port-field enable cbval))))))
             
             (tnail-hpanel (new horizontal-panel% [parent prefd] [alignment '(left top)]))
             (current-tn-val (send prefs get-param thumbnail-cache-folder-param))
             (tn-text (new text-field% 
                           [label (get-string "THUMBNAIL_CACHE_FOLDER_PREFERENCE_LABEL")] 
                           [parent tnail-hpanel] 
                           [init-value current-tn-val]))
             (vc-hpanel (new horizontal-panel% [parent prefd] [alignment '(left top)]))
             (vc-text (new text-field% 
                           [label (get-string "VIDEO_CACHE_FOLDER_PREFERENCE_LABEL")] 
                           [parent vc-hpanel] 
                           [init-value (send prefs get-param video-cache-folder-param)]))
             (mp-hpanel (new horizontal-panel% [parent prefd] [alignment '(left top)]))
             (mp-field (new text-field% 
                            [label (get-string "MEDIA_PLAYER_PREFERENCE_LABEL")] 
                            [parent mp-hpanel] 
                            [init-value (send prefs get-param media-player-param)]))
             (l-field (new combo-field% 
                           [label (get-string "LANGUAGE_PREFERENCE_LABEL")] 
                           [parent pref-vpanel] 
                           [init-value (send prefs get-param language-param)]
                           [choices (map get-language-name (get-all-languages))]))
             (pd-field (new check-box% 
                            [label (get-string "PLAY_VIDEO_ON_DOWNLOAD_PREFERENCE_LABEL")] 
                            [parent pref-vpanel] 
                            [value (send prefs get-param play-video-on-download?-param)])) 
             (si-field (new check-box% 
                            [label (get-string "SHOW_IMAGES_PREFERENCE_LABEL")] 
                            [parent pref-vpanel] 
                            [value (send prefs get-param show-images?-param)])) 
             (sc-field (new check-box% 
                            [label (get-string "SHOW_COMMENTS_PREFERENCE_LABEL")] 
                            [parent pref-vpanel] 
                            [value (send prefs get-param show-comments?-param)])) 
             (sh-field (new check-box% 
                            [label (get-string "SAVE_HISTORY_PREFERENCE_LABEL")] 
                            [parent pref-vpanel] 
                            [value (send prefs get-param save-history?-param)])) 
             (hs-field (new text-field% 
                            [label (get-string "ITEMS_IN_HISTORY_PREFERENCE_LABEL")] 
                            [parent pref-vpanel] 
                            [init-value (send prefs get-param history-size-param)]))
             (rpp-field (new combo-field% 
                             [label (get-string "RESULTS_PER_PAGE_PREFERENCE_LABEL")] 
                             [parent pref-vpanel] 
                             [init-value (send prefs get-param results-per-page-param)]
                             [choices (list "1" "2" "3" "4" "5" "6")]))
             (d-format #f) ; this will contain the format if the format value is changed
             (df-field (let ((format-name-list (map get-string (map get-format-name *formats-list*)))
                             (current-format-name (get-string (send prefs get-param download-format-param))))
                         (new choice% 
                              [label (get-string "DOWNLOAD_FORMAT_PREFERENCE_LABEL")] 
                              [parent pref-vpanel] 
                              [selection (- (length format-name-list) (length (member current-format-name format-name-list)))]
                              ;                            [init-value (get-string (send prefs get-param download-format-param))]
                              [choices format-name-list]
                              [callback 
                               (lambda (c e)
                                 (set! d-format (get-format-by-i18n-name (get-nth-item-in-list (send c get-selection) format-name-list))))])))
             )
        (new button% 
             [label (get-string "SELECT_BUTTON_LABEL")] 
             [parent tnail-hpanel] 
             (callback (lambda (button event)
                         (let ((new-val (get-directory "Select Thumbnail Cache Folder" prefd)))
                           (if (not (eq? new-val #f))
                               (send tn-text set-value (path->string new-val)))))))
        (new button% 
             [label (get-string "SELECT_BUTTON_LABEL")] 
             [parent vc-hpanel] 
             (callback (lambda (button event)
                         (let ((new-val (get-directory "Select Video Cache Folder" prefd)))
                           (if (not (eq? new-val #f))
                               (send vc-text set-value (path->string new-val)))))))
        
        (new button% 
             [label (get-string "SELECT_BUTTON_LABEL")] 
             [parent mp-hpanel] 
             (callback (lambda (button event)
                         (let ((new-val (get-file "Select Media Player" prefd)))
                           (if (not (eq? new-val #f))
                               (send mp-field set-value (path->string new-val)))))))
        
        
        (let* ((button-hpanel (new horizontal-panel% [parent prefd] [alignment '(center top)])))
          (new button% 
               [label (get-string "SAVE_BUTTON_LABEL")]
               [min-width 100]
               [parent button-hpanel] 
               (callback (lambda (button event)
                           (send prefs set-param thumbnail-cache-folder-param 
                                 (send tn-text get-value))
                           (send prefs set-param video-cache-folder-param 
                                 (send vc-text get-value))
                           (send prefs set-param history-size-param 
                                 (send hs-field get-value))
                           (send prefs set-param results-per-page-param 
                                 (send rpp-field get-value))
                           (send prefs set-param play-video-on-download?-param 
                                 (send pd-field get-value))
                           (send prefs set-param show-images?-param 
                                 (send si-field get-value))
                           (send prefs set-param show-comments?-param 
                                 (send sc-field get-value))
                           (send prefs set-param save-history?-param 
                                 (send sh-field get-value))
                           (send prefs set-param media-player-param 
                                 (send mp-field get-value))
                           (send prefs set-param language-param
                                 (send l-field get-value))
                           (if (eq? d-format #f)
                               #f
                               (send prefs set-param download-format-param (get-format-name d-format)))
                           (let ((proxy (construct-proxy
                                         (send proxy-host-field get-value)
                                         (send proxy-port-field get-value)
                                         (send use-proxy-field get-value))))
                             (send prefs set-param http-proxy-details-param proxy))
                           (send prefs save-prefs)
                           (set-current-proxy-server)
                           (send (send button get-top-level-window) show #f))))
          (new button% 
               [label (get-string "CANCEL_BUTTON_LABEL")] 
               [min-width 100]
               [parent button-hpanel] 
               (callback (lambda (button event)
                           (send (send button get-top-level-window) show #f))))))
      prefd
      )
    )
  
  ;gets the name of the format by its i18n name
  (define (get-format-by-i18n-name name)
    (define (get-format formats fn)
      (if (eq? formats '())
          #f
          (begin
            (let* ((current-format (car formats))
                   (current-format-name (get-format-name current-format)))
              (if (equal? (get-string current-format-name) fn)
                  current-format
                  (get-format (cdr formats) fn))))))
    (get-format *formats-list* name))
  
  (define (get-nth-item-in-list n list)
    (if (eq? list '())
        #f
        (if (eq? n 0)
            (car list)
            (get-nth-item-in-list (- n 1) (cdr list)))))
  )